home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / propage / genies / frenchgenies / rexx / alignetextesurgrille.pprx < prev    next >
Text File  |  1993-08-03  |  6KB  |  191 lines

  1. /*
  2. @BAligneTexteSurGrille @B @I Ecrit et © par Don Cox en août 1992
  3. @IN'est pas du Domaine Publique. Tous Droits Réservés.
  4. Traduit par Fabien Larini le 02/08/93.
  5.  
  6. Ce Génie permet d'espacer les lignes de texte de la valeur de la hauteur 
  7. de la grille. Par exemple, si votre grille fait 1.2 picas de haut, chaque 
  8. ligne de texte sera espacée de 1.2 picas de la suivante. Ce Génie est 
  9. utile pour arranger des colonnes parallèles. Il suffit de clicker dans une
  10. boîte de la chaîne ou dans une boîte ou plusieurs boîtes simples. Si la 
  11. hauteur de grille est grande, vous aurez 2 ou 3 lignes de texte dans la
  12. hauteur de Grille.
  13. */
  14.  
  15. /* TextToGrid*/
  16. /* This Genie fits text to the Y spacing of the grid. For instance, if your 
  17. grid Y setting is 1.2 picas, all the text in an article will be spaced with 
  18. lines 14 points apart. This is useful for tidying up parallel columns. You 
  19. need only click on one box in each article: all the text in a box or linked
  20. chain will be changed.
  21. If the grid spacing is large, you may get two or three lines of text in each
  22. grid unit. In this version the bounding boxes of the letters are fitted to 
  23. the grid; in a later version it may be possible to place the baselines on 
  24. the grid.
  25. Written by Don Cox  Aug 92   Copyright. Not Public Domain. All rights resrved. */
  26.  
  27. trace n
  28. signal on error
  29. signal on syntax
  30. address command
  31. call SafeEndEdit.rexx()
  32. call ppm_AutoUpdate(0)
  33. cr="0a"x
  34.  
  35. cpage = ppm_CurrentPage()
  36. counter=0
  37.  
  38. do forever
  39.     box=ppm_ClickOnBox("Clickez dans les Boîtes contenant le Texte à espacer")
  40.     if box=0 then break
  41.     counter=counter+1
  42.     boxes.counter=box
  43.     call ppm_SelectBox(box)
  44. end
  45.  
  46. if counter=0 then exit_msg("Pas de Boîte Sélectionnée")
  47. currentunits=ppm_GetUnits()
  48. call ppm_SetUnits(2)
  49. randval = (randu() * time(s)) % 1 /* mark boxes with random number to avoid doing them twice */
  50.  
  51. gridsize = ppm_GetGridSize()
  52. spacing = word(gridsize,2) /* we only want the Y value */
  53.  
  54.  
  55. call ppm_ShowStatus("Espacement du Texte ...")
  56. do i=1 to counter
  57.     box=boxes.i
  58.  
  59.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  60.     if boxtype~="TEXTE" then iterate
  61.     oldbox = box
  62.     box = ppm_ArtFirstBox(box)
  63.     boxone = box
  64.     do forever  /* Tops of boxes to grid */
  65.         Ypos = word(ppm_GetBoxPosition(box),2)
  66.         Xpos = word(ppm_GetBoxPosition(box),1)
  67.         oddbit = Ypos//spacing
  68.         if oddbit<= spacing/2 then call ppm_SetBoxPosition(box,Xpos, Ypos-oddbit)
  69.         else call ppm_SetBoxPosition(box,Xpos, Ypos+spacing-oddbit)
  70.         box = ArtNextBox(box)
  71.         if box = 0 then break
  72.         end
  73.     box = boxone
  74.     text = ppm_GetArticleText(box,1)
  75.     text = RespaceText(text,spacing)
  76.     gone = ppm_DeleteContents(box)
  77.     overflow = ppm_TextIntoBox(box,text)
  78.     do while box ~= 0  /* mark all the other boxes in this chain  */
  79.         call ppm_SetBoxUserData(box, randval)
  80.         box = ppm_ArtNextBox(box)
  81.         end
  82.     box = oldbox  /* back to the box we are working on */
  83.     end
  84.  
  85. newpage = ppm_GoToPage(cpage)
  86. call ppm_SetUnits(currentunits)
  87.  
  88. call exit_msg()
  89. end
  90.  
  91. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  92.  
  93. RespaceText: procedure
  94. parse arg text, spacing
  95. position = 1
  96. position2 = 1
  97.  
  98. do forever  /* we have to open up style tags to get sizes */
  99.     position = pos("\dS<",text,position2)
  100.     if position = 0 then break
  101.     position2 = pos(">",text,position)
  102.     if position2 = 0 then break
  103.     styletag = substr(text,position+4, position2-position-4)
  104.     styledef = ppm_GetStyleTagData(styletag)
  105.     styledef = left(styledef,pos("}",styledef)-1) /* remove name of tag */
  106.     styledef = substr(styledef,pos("{",styledef)+1)
  107.     text = delstr(text,position, (position2-position+1)) /* delete tag name */
  108.     text = insert("\ds"styledef,text,(position-1))
  109.     end
  110.  
  111. position2 = 1
  112. do forever  /* first, for relative spacing we need font sizes */
  113.     position = pos("\fs<",text,position2)+4
  114.     if position = 4 then break  /* would be 0 but we added 4 */
  115.     position2 = pos(">",text,position)
  116.     if position2 = 0 then break
  117.     fontsize = substr(text,position, position2-position)
  118.     fontsize = fontsize/28.346457 /* convert to cm  */
  119.     position = pos("\lr<",text,position2)+4
  120.     if position = 4 then break  /* would be 0 but we added 4 */
  121.     position2 = pos(">",text,position)
  122.     if position2 = 0 then break
  123.     relspace = substr(text,position, position2-position)
  124.     text = delstr(text,position, position2-position) /* delete old size */
  125.     newspace = spacing%((relspace/100)*fontsize)
  126.     if newspace = 0 then newspace = 1
  127.     newspace = spacing/newspace*28.346457  /* back to points */
  128.     text = overlay("lf",text,position-3)
  129.     text = insert(newspace,text,position-1)
  130.     end
  131.  
  132.  
  133. position2 = 1
  134. do forever  /*  now fixed line spacings  */
  135.     position = pos("\lf<",text,position2)+4
  136.     if position = 4 then break  /* would be 0 but we added 4 */
  137.     position2 = pos(">",text,position)
  138.     if position2 = 0 then break
  139.     oldsize = substr(text,position, position2-position)
  140.     text = delstr(text,position, position2-position) /* delete old size */
  141.     oldsize = oldsize/28.346457
  142.     newspace = (spacing%oldsize)
  143.     if newspace = 0 then newspace = 1
  144.     newspace = spacing/newspace*28.346457
  145.     text = insert(newspace,text,position-1)
  146.     end
  147.  
  148. position2 = 1
  149. do forever   /* and fixed leading  */
  150.     position = pos("\fs<",text,position2)+4
  151.     if position = 4 then break  /* would be 0 but we added 4 */
  152.     position2 = pos(">",text,position)
  153.     if position2 = 0 then break
  154.     fontsize = substr(text,position, position2-position)
  155.     position = pos("\ll<",text,position2)+4
  156.     if position = 4 then break  /* would be 0 but we added 4 */
  157.     position2 = pos(">",text,position)
  158.     if position2 = 0 then break
  159.     leading = substr(text,position, position2-position)
  160.     text = delstr(text,position, position2-position) /* delete old size */
  161.     newspace = (leading+fontsize)/28.346457
  162.     newspace = (spacing%newspace)
  163.     if newspace = 0 then newspace = 1
  164.     newspace = spacing/newspace*28.346457
  165.     text = overlay("lf",text,position-3)
  166.     text = insert(newspace,text,position-1)
  167.     end
  168.  
  169.  
  170. return text
  171.  
  172.  
  173. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  174.  
  175. error:
  176. syntax:
  177.     do
  178.     exit_msg("Arrêt du Génie dû à l'erreur: "errortext(rc)) 
  179.     end
  180.  
  181. exit_msg:
  182.     do
  183.     parse arg message
  184.     if message ~= "" then
  185.     call ppm_Inform(1,message,)
  186.     call ppm_ClearStatus()
  187.     call ppm_AutoUpdate(1)
  188.     exit
  189.     end
  190.  
  191.